perm filename TAX.F4[LIB,LCS]3 blob
sn#146437 filedate 1975-02-15 generic text, type T, neo UTF8
00100 C***** INCOME TAX HELPER ******
00200 CC DIMENSION WAGES(10),DIV(10),RINT(10),BINC(10),
00300 CC 1 CAS(10),SUPS(10),ROY(10),PENS(10),CAPG(10),SITR(10),
00400 CC 1 OTH(10),EBEX(10),RMED(20),TAXES(10),XOTH(10),CONTR(10),
00500 CC 1 TLOSS(10),RMIN(10),DOC(10),DOTH(10),RTAX(10),RMORT(10),
00600 CC 1 ROTH(10),OCONT(10),OCASH(10),UNION(10),RMOTH(10),WTAX(10)
00700 CC 1,ETAX(10),FICA(10)
00800 COMMON K,ACC,IOUT
00900 IOUT=5
01000 C**** -99=BACKUP **************
01100 C*** UP TO 10 NUMBERS MAY BE ENTERED IF PROG. GIVES <CR> BEFORE ACCEPT.
01200 C 5=TTY 3=LPT
01300 ACC=-1
01400 TYPE 200
01500 ACCEPT 3,N
01600 IF(N.NE.'O')GO TO 60
01700 200 FORMAT(' N=NEW TAX WORK -- OR O=GET OLD FILE. H=HELP'/)
01800 TYPE 85
01900 ACCEPT 4,NAME
02000 GO TO 201
02100 33 FORMAT('+ STANDARD DEDUCTION - NOT MORE THAN $2000 OR $1000'/)
02200 45 FORMAT('+ REAL ESTATE.'/)
02300 55 FORMAT('+ INSURANCE REIMBURSEMENT.'/)
02400 57 FORMAT('+ ALIMONY PAID.'/)
02500 58 FORMAT('+ UNION DUES.'/)
02600 59 FORMAT('+ CHILD AND DEPENDENT CARE(FORM 2441)'/)
02700 60 FORMAT('+ TOTAL--- ',F10.2/)
02800 IF(N.NE.'H')GO TO 4
02900 TYPE 202
03000 CALL EXIT
03100 202 FORMAT(' ASK LCS FOR INFORMATION.')
03200 1 FORMAT(20F)
03300 2 FORMAT(F10.2/)
03400 3 FORMAT(A1)
03500 4 FORMAT(A5)
03600 I=' '
03700
03800 601 FORMAT(' ***** YOU ARE ON FORM 1040, PG.1 *****'/)
03900 WRITE(IOUT,601)
04000 IF(ACC.EQ.0)GO TO 102
04100 TYPE 604
04200 604 FORMAT(' TO BACKUP TYPE -99 '/)
04300 600 FORMAT('+ ARE YOU MARRIED, FILING SEPARATELY? '$)
04400 CALL TYP(3,I)
04410 TYPE 600
04500 ACCEPT 3,MFS
04600 102 CALL TYP(7,I)
04700 WRITE(IOUT, 11)
04800 11 FORMAT('+ NUMBER OF EXEMPTIONS ',$)
04900 CALL ADUP(EX)
05000 IF(EX.EQ.-99)GO TO 600
05100 1100 CALL TYP(9,I)
05200 WRITE(IOUT, 12)
05300 12 FORMAT('+ WAGES, ETC. (FROM W2 FORMS) '/)
05400 CALL ADUP(WG)
05500 IF(WG.EQ.-99)GO TO 102
05600 103 CALL TYP(10,'A')
05700 WRITE(IOUT, 13)
05800 13 FORMAT('+ DIVIDENDS.'/)
05900 CALL ADUP(DT)
06000 IF(DT.EQ.-99)GO TO 102
06100 IF(DT.EQ.0)GO TO 105
06200 104 CALL TYP(10,'B')
06300 WRITE(IOUT, 14)
06400 14 FORMAT('+ DIVIDEND EXCLUSION. ',$)
06500 CALL ADUP(DEX)
06600 IF(DEX.EQ.-99)GO TO 103
06700 TOTD=DT-DEX
06800 CALL TYP(10,'C')
06900 WRITE(IOUT, 15)TOTD
07000 15 FORMAT('+ TOTAL DIVIDENDS. ',F11.2/)
07100 105 CALL TYP(11,I)
07200 WRITE(IOUT, 16)
07300 16 FORMAT('+ INTEREST INCOME. '/)
07400 CALL ADUP(RT)
07500 IF(RT.EQ.-99)GO TO 104
07600 106 CALL TYP(12,I)
07700 WRITE(IOUT, 17)
07800 17 FORMAT('+ OTHER INCOME.'/)
07900 602 FORMAT(' ***** GO TO PAGE 2 OF FORM 1040 *****'/,
08000 1' ***** TYPE -999 TO SKIP OVER SECTION AND RETURN TO PG.1'/)
08100 IF(ACC.EQ.0.AND.T38.EQ.0)GO TO 1603
08200 WRITE(IOUT,602)
08300 CALL TYP(28,I)
08400 WRITE(IOUT, 18)
08500 18 FORMAT('+ BUSINESS INCOME-LOSS.'/)
08600 CALL ADUP(BI)
08700 IF(BI.EQ.-999)GO TO 1603
08800 IF(BI.EQ.-99)GO TO 105
08900 107 CALL TYP(29,I)
09000 WRITE(IOUT, 19)
09100 19 FORMAT('+ CAPITAL ASSETS.'/)
09200 CALL ADUP(CA)
09300 IF(CA.EQ.-99)GO TO 106
09400 108 CALL TYP(30,I)
09500 WRITE(IOUT, 20)
09600 20 FORMAT('+ SUPPLEMENTAL SCHEDULE.'/)
09700 CALL ADUP(SU)
09800 IF(SU.EQ.-99)GO TO 107
09900 109 CALL TYP(31,I)
10000 WRITE(IOUT, 21)
10100 21 FORMAT('+ RENTS, ROYALTIES, ETC.'/)
10200 CALL ADUP(RY)
10300 IF(RY.EQ.-99)GO TO 108
10400 110 CALL TYP(33,I)
10500 WRITE(IOUT, 22)
10600 22 FORMAT('+ PENSIONS, ETC.'/)
10700 CALL ADUP(PE)
10800 IF(PE.EQ.-99)GO TO 109
10900 111 CALL TYP(34,I)
11000 WRITE(IOUT, 23)
11100 23 FORMAT('+ 50% CAPITAL GAIN.'/)
11200 CALL ADUP(CP)
11300 IF(CP.EQ.-99)GO TO 110
11400 112 CALL TYP(35,I)
11500 WRITE(IOUT, 24)
11600 24 FORMAT('+ STATE INCOME TAX REFUNDS.'/)
11700 CALL ADUP(SI)
11800 IF(SI.EQ.-99)GO TO 111
11900 113 CALL TYP(36,I)
12000 WRITE(IOUT, 25)
12100 25 FORMAT('+ ALIMONY INCOME. '/)
12200 CALL ADUP(ALM)
12300 IF(ALM.EQ.-99)GO TO 112
12400 114 CALL TYP(37,I)
12500 WRITE(IOUT, 26)
12600 26 FORMAT('+ OTHER.'/)
12700 CALL ADUP(OT)
12800 IF(OT.EQ.-99)GO TO 113
12900 CALL TYP(38,I)
13000 T38=BI+CA+SU+RY+PE+CP+SI+ALM+OT
13100 WRITE(IOUT, 60)T38
13200 603 FORMAT(' ***** GO BACK TO PAGE 1 OF FORM 1040 *****'/)
13300 WRITE(IOUT,603)
13400 1603 CALL TYP(12,I)
13500 IF(BI.EQ.-999)BI=0
13600 WRITE(IOUT,60)T38
13700 CALL TYP(13,I)
13800 T13=WG+TOTD+RT+T38
13900 WRITE(IOUT, 60)T13
14000 115 CALL TYP(14,I)
14100 WRITE(IOUT, 27)
14200 27 FORMAT('+ ADJUSTMENTS TO INCOME'/)
14300
14400 IF(ACC.EQ.0.AND.T43.EQ.0)GO TO 1604
14500 WRITE(IOUT,602)
14600 CALL TYP(39,I)
14700 WRITE(IOUT, 28)
14800 28 FORMAT('+ SICK PAY. ',/)
14900 CALL ADUP(SICK)
15000 IF(SICK.EQ.-999)GO TO 1604
15100 IF(SICK.EQ.-99)GO TO 114
15200 116 CALL TYP(40,I)
15300 WRITE(IOUT, 29)
15400 29 FORMAT('+ MOVING EXPENSES. ',/)
15500 CALL ADUP(RMEX)
15600 IF(RMEX.EQ.-99)GO TO 115
15700 117 CALL TYP(41,I)
15800 WRITE(IOUT, 30)
15900 30 FORMAT('+ EMPLOYEE BUSINESS EXPENSES.'/)
16000 CALL ADUP(EB)
16100 IF(EB.EQ.-99)GO TO 116
16200 118 CALL TYP(42,I)
16300 WRITE(IOUT, 31)
16400 31 FORMAT('+ SELF-EMPLOYED RETIREMENT PLAN. '/)
16500 CALL ADUP(SER)
16600 IF(SER.EQ.-99)GO TO 117
16700 CALL TYP(43,I)
16800 T43=SICK+RMEX+EB+SER
16900 WRITE(IOUT, 60)T43
17000
17100 WRITE(IOUT,603)
17200 1604 CALL TYP(14,I)
17300 IF(SICK.EQ.-999)SICK=0
17400 WRITE(IOUT, 60)T43
17500 T15=T13-T43
17600 CALL TYP(15,I)
17700 WRITE(IOUT, 32)T15
17800 32 FORMAT('+ ADJUSTED GROSS INCOME.',F13.2/)
17900 IF(T15.LT.10000.)CALL SMALL(T15)
18000 CALL STDED(T15)
18100 IF(ACC)WRITE(IOUT, 34)
18200 34 FORMAT(/' ***** ITEMIZE DEDUCTIONS? '$)
18300 IF(ACC)ACCEPT 3,JIT
18400 IF(JIT.EQ.'N')GO TO 6900
18500 C*************************************
18600 119 WRITE(IOUT, 35)
18700 35 FORMAT(/' ***** GO TO SCHEDULE A *****')
18800 WRITE(IOUT, 36)
18900 36 FORMAT(/' ----- MEDICAL - DENTAL '/)
19000 IF(ACC.EQ.0)GO TO 3700
19100 CALL TYP(1,I)
19200 WRITE(IOUT, 37)
19300 37 FORMAT('+ TOTAL OF INSURANCE PREMIUMS. '/)
19400 CALL ADUP(RMI)
19500 IF(RMI.EQ.-99)GO TO 118
19600 3700 T1=RMI/2.
19700 IF(T1.GT.150.)T1=150.
19800 CALL TYP(1,I)
19900 WRITE(IOUT, 2)T1
20000 120 CALL TYP(2,I)
20100 WRITE(IOUT, 38)
20200 38 FORMAT('+ MEDICINE AND DRUGS. '/)
20300 CALL ADUP(RM)
20400 IF(RM.EQ.-99)GO TO 119
20500 CALL TYP(3,I)
20600 61 FORMAT('+ 1% OF LINE 15-- ',F10.2/)
20700 ONP=T15/100.
20800 WRITE(IOUT, 61)ONP
20900 T4=RM-ONP
21000 IF(T4)T4=0
21100 CALL TYP(4,I)
21200 WRITE(IOUT, 2)T4
21300 CALL TYP(5,I)
21400 T5=RMI-T1
21500 IF(T5)T5=0
21600 62 FORMAT('+ BALANCE OF INSURANCE PREMIUMS. ',F10.2/)
21700 WRITE(IOUT, 62)T5
21800 CALL TYP(6,I)
21900 WRITE(IOUT, 39)
22000 39 FORMAT('+ OTHER MEDICAL AND DENTAL EXPENSES.'/)
22100 121 CALL TYP(6,'A')
22200 WRITE(IOUT, 40)
22300 40 FORMAT('+ DOCTORS, DENTISTS, ETC.'/)
22400 CALL ADUP(DO)
22500 IF(DO.EQ.-99)GO TO 120
22600 122 CALL TYP(6,'B')
22700 WRITE(IOUT, 41)
22800 41 FORMAT('+ HOSPITALS.'/)
22900 CALL ADUP(HOSP)
23000 IF(HOSP.EQ.-99)GO TO 121
23100 123 CALL TYP(6,'C')
23200 WRITE(IOUT, 26)
23300 CALL ADUP(DOTH)
23400 IF(DOTH.EQ.-99)GO TO 122
23500 T7=T4+T5+DO+HOSP+DOTH
23600 CALL TYP(7,I)
23700 WRITE(IOUT, 60)T7
23800 T8=T15*.03
23900 CALL TYP(8,I)
24000 WRITE(IOUT, 2)T8
24100 T9=T7-T8
24200 IF(T9)T9=0
24300 CALL TYP(9,I)
24400 WRITE(IOUT, 2)T9
24500 T10=T9+T1
24600 CALL TYP(10,I)
24700 WRITE(IOUT, 60)T10
24800 CALL TYP(35,I)
24900 WRITE(IOUT, 60)T10
25000
25100 43 FORMAT(/' ----- TAXES'/)
25200 WRITE(IOUT, 43)
25300 124 CALL TYP(11,I)
25400 WRITE(IOUT, 44)
25500 44 FORMAT('+ STATE AND LOCAL INCOME.'/)
25600 CALL ADUP(TA)
25700 IF(TA.EQ.-99)GO TO 123
25800 125 CALL TYP(12,I)
25900 WRITE(IOUT, 45)
26000 CALL ADUP(RX)
26100 IF(RX.EQ.-99)GO TO 124
26200 126 CALL TYP(13,I)
26300 WRITE(IOUT, 42)
26400 42 FORMAT('+ GASOLINE TAX (SEE TABLES) '/)
26500 CALL ADUP(GTAX)
26600 IF(GTAX.EQ.-99)GO TO 125
26700 127 CALL TYP(14,I)
26800 WRITE(IOUT, 46)
26900 46 FORMAT('+ GENERAL SALES. (SEE TABLES) '/)
27000 CALL ADUP(STAX)
27100 IF(STAX.EQ.-99)GO TO 126
27200 128 CALL TYP(15,I)
27300 WRITE(IOUT, 47)
27400 47 FORMAT('+ PERSONAL PROPERTY'/)
27500 CALL ADUP(PTAX)
27600 IF(PTAX.EQ.-99)GO TO 127
27700 129 CALL TYP(16,I)
27800 WRITE(IOUT, 26)
27900 CALL ADUP(XO)
28000 IF(XO.EQ.-99)GO TO 128
28100 CALL TYP(17,I)
28200 T17=TA+RX+GTAX+STAX+PTAX+XO
28300 WRITE(IOUT, 60)T17
28400 CALL TYP(36,I)
28500 WRITE(IOUT, 60)T17
28600 130 WRITE(IOUT, 48)
28700 48 FORMAT(/' ----- INTEREST EXPENSE'/)
28800 CALL TYP(18,I)
28900 WRITE(IOUT, 49)
29000 49 FORMAT('+ HOME MORTGAGE.'/)
29100 CALL ADUP(RMO)
29200 IF(RMO.EQ.-99)GO TO 129
29300 131 CALL TYP(19,I)
29400 WRITE(IOUT, 26)
29500 CALL ADUP(ROH)
29600 IF(ROH.EQ.-99)GO TO 130
29700 CALL TYP(20,I)
29800 T20=RMO+ROH
29900 WRITE(IOUT, 60)T20
30000 CALL TYP(37,I)
30100 WRITE(IOUT, 60)T20
30200
30300 132 WRITE(IOUT, 50)
30400 50 FORMAT(/' ----- CONTRIBUTIONS '/)
30500 CALL TYP(21,'A')
30600 WRITE(IOUT, 51)
30700 51 FORMAT('+ CASH CONTRIBUTIONS.'/)
30800 CALL ADUP(CO)
30900 IF(CO.EQ.-99)GO TO 131
31000 133 CALL TYP(21,'B')
31100 WRITE(IOUT, 26)
31200 CALL ADUP(OC)
31300 IF(OC.EQ.-99)GO TO 132
31400 134 CALL TYP(22,I)
31500 WRITE(IOUT, 510)
31600 510 FORMAT('+ OTHER THAN CASH (SEE PAGE 12).'/)
31700 CALL ADUP(OCA)
31800 IF(OCA.EQ.-99)GO TO 133
31900 135 CALL TYP(23,I)
32000 WRITE(IOUT, 52)
32100 52 FORMAT('+ CARRY OVER FROM PRIOR YEARS.'/)
32200 CALL ADUP(PRIOR)
32300 IF(PRIOR.EQ.-99)GO TO 134
32400 136 CALL TYP(24,I)
32500 T24=PRIOR+OCA+OC+CO
32600 WRITE(IOUT, 60)T24
32700 CALL TYP(38,I)
32800 WRITE(IOUT, 60)T24
32900 137 WRITE(IOUT, 53)
33000 53 FORMAT(/' ----- CASUALTY OR THEFT LOSSES'/)
33100 CALL TYP(25,I)
33200 54 FORMAT('+ LOSS BEFORE INSURANCE REIMBURSEMENT.'/)
33300 WRITE(IOUT, 54)
33400 CALL ADUP(RLOSS)
33500 IF(RLOSS.EQ.-99)GO TO 135
33600 IF(RLOSS.EQ.0)GO TO 139
33700 138 CALL TYP(26,I)
33800 WRITE(IOUT, 55)
33900 CALL ADUP(RIR)
34000 IF(RIR.EQ.-99)GO TO 137
34100 CALL TYP(27,I)
34200 T27=RLOSS-RIR
34300 IF(T27)T27=0
34400 WRITE(IOUT, 60)T27
34500 T28=100.
34600 IF(T27.LT.T28)T28=T27
34700 CALL TYP(28,I)
34800 WRITE(IOUT, 2)T28
34900 T29=T27-T28
35000 CALL TYP(29,I)
35100 WRITE(IOUT, 60)T29
35200 CALL TYP(39,I)
35300 WRITE(IOUT, 60)T29
35400 139 WRITE(IOUT, 56)
35500 56 FORMAT(/' ----- MISCELLANEOUS DEDUCTIONS '/)
35600 CALL TYP(30,I)
35700 WRITE(IOUT, 57)
35800 CALL ADUP(ALIMON)
35900 IF(ALIMON.EQ.-99)GO TO 138
36000 140 CALL TYP(31,I)
36100 WRITE(IOUT, 58)
36200 CALL ADUP(UN)
36300 IF(UN.EQ.-99)GO TO 139
36400 141 CALL TYP(32,I)
36500 WRITE(IOUT, 59)
36600 CALL ADUP(CAD)
36700 IF(CAD.EQ.-99)GO TO 140
36800 142 CALL TYP(33,I)
36900 WRITE(IOUT, 26)
37000 CALL ADUP(SOTH)
37100 IF(SOTH.EQ.-99)GO TO 141
37200 T34=ALIMONY+UN+CAD+SOTH
37300 CALL TYP(34,I)
37400 WRITE(IOUT, 60)T34
37500 CALL TYP(40,I)
37600 WRITE(IOUT, 60)T34
37700 WRITE(IOUT, 63)
37800 63 FORMAT(' ----- SUMMARY OF DEDUCTIONS.'/)
37900 CALL TYP(35,I)
38000 WRITE(IOUT, 64)T10
38100 64 FORMAT('+ MEDICAL AND DENTAL.',F12.2/)
38200 CALL TYP(36,I)
38300 WRITE(IOUT, 65)T17
38400 65 FORMAT('+ TOTAL TAXES.',F12.2/)
38500 650 FORMAT('+ TOTAL INTEREST.',F12.2/)
38600 66 FORMAT('+ TOTAL CONTRIBUTIONS.',F12.2/)
38700 67 FORMAT('+ CASUALTY OR THEFT LOSS.',F12.2/)
38800 68 FORMAT('+ TOTAL MISCELLANEAOUS.',F12.2/)
38900 69 FORMAT('+ TOTAL DEDUCTIONS.',F12.2/)
39000 CALL TYP(37,I)
39100 WRITE(IOUT, 650)T20
39200 CALL TYP(38,I)
39300 WRITE(IOUT, 66)T24
39400 CALL TYP(39,I)
39500 WRITE(IOUT, 67)T29
39600 CALL TYP(40,I)
39700 WRITE(IOUT, 68)T34
39800 CALL TYP(41,I)
39900 T41=T34+T29+T20+T17+T10
40000 WRITE(IOUT, 69)T41
40100
40200 WRITE(IOUT,602)
40300 6900 CALL TYP(44,I)
40400 WRITE(IOUT,32)T15
40500 IF(JIT.NE.'Y')GO TO 6901
40600 CALL TYP(45,'A')
40700 WRITE(IOUT, 69)T41
40800 6901 T45B=T15*.15
40900 X=2000
41000 IF(MFS.EQ.'Y')X=1000
41100 IF(T45B.GT.X)T45B=X
41200 CALL TYP(45,'B')
41300 WRITE(IOUT, 69)T45B
41400 T46=T15-T41
41500 T46B=T15-T45B
41600 IF(JIT.NE.'Y')GO TO 6902
41700 CALL TYP(46,'A')
41800 WRITE(IOUT, 2)T46
41900 6902 CALL TYP(46,'B')
42000 WRITE(IOUT, 2)T46B
42100 CALL TYP(47,I)
42200 X=EX*750
42300 WRITE(IOUT, 70)X
42400 70 FORMAT('+ EXEMPTIONS X $750.',F12.2/)
42500 IF(JIT.NE.'Y')GO TO 71
42600 CALL TYP(48,'A')
42700 T48=T46-X
42800 WRITE(IOUT, 71)T48
42900 71 FORMAT('+ TAXABLE INCOME -- ',F12.2/)
43000 T48B=T46B-X
43100 CALL TYP(48,'B')
43200 WRITE(IOUT, 71)T48B
43300 7216 WRITE(IOUT, 72)
43400 72 FORMAT(//' FIGURE YOUR TAX WITH SCHED. X,Y OR Z.'/)
43500 IF(ACC.EQ.0)GO TO 73
43600 TYPE 722
43700 722 FORMAT(' TYPE APPROPRIATE $, % AND $ FROM LAST 2 COLUMNS OF
43800 1SCHEDULES X, Y OR Z.'/)
43900 ACCEPT 1,X,Y,Z
44000 IF(X.EQ.-99)GO TO 142
44100 IF(JIT.NE.'Y')T48=T48B
44200 TAX=X+(T48-Z)*Y/100.
44300 CC TAXB=X+(T48B-Z)*Y/100.
44400 73 FORMAT('+ YOUR TAX -- ',F12.2/)
44500 CALL TYP(16,I)
44600 WRITE(IOUT,73)TAX
44700 CC CALL TYP(16,'B')
44800 CC WRITE(IOUT,73)TAXB
44900 C****** CREDITS ********************
45000 741 FORMAT(' ----- CREDITS'/)
45100 WRITE(IOUT,741)
45200
45300 IF(ACC.EQ.0.AND.T54.EQ.0)GO TO 1605
45400 WRITE(IOUT,602)
45500 CALL TYP(49,I)
45600 742 FORMAT('+ RETIREMENT INCOME CREDIT. (SCHED. R) '/)
45700 WRITE(IOUT,742)
45800 CALL ADUP(RIC)
45900 IF(RIC.EQ.-999)GO TO 1605
46000 IF(RIC.EQ.-99)GO TO 142
46100 743 FORMAT('+ INVESTMENT CREDIT. (FORM 3468) '/)
46200 CALL TYP(50,I)
46300 WRITE(IOUT,743)
46400 CALL ADUP(RIVC)
46500 IF(RIVC.EQ.-99)GO TO 742
46600 744 FORMAT('+ FOREIGN TAX CREDIT. (FORM 1116) '/)
46700 CALL TYP(51,I)
46800 WRITE(IOUT,744)
46900 CALL ADUP(FTX)
47000 IF(FTX.EQ.-99)GO TO 743
47100 745 FORMAT('+ CREDIT FOR CONTRBS. TO CANDS. (SEE PG.9) '/)
47200 CALL TYP(52,I)
47300 WRITE(IOUT,745)
47400 CALL ADUP(CCC)
47500 IF(CCC.EQ.-99)GO TO 744
47600 746 FORMAT('+ WORK INCENTIVE CREDIT. (FORM 4874) '/)
47700 CALL TYP(53,I)
47800 WRITE(IOUT,746)
47900 CALL ADUP(WIC)
48000 IF(WIC.EQ.-99)GO TO 745
48100 CALL TYP(54,I)
48200 T54=RIC+FTX+CCC+WIC+RIVC
48300 WRITE(IOUT,60)T54
48400 C******************************* PAGE 1 AGAIN ***********
48500 WRITE(IOUT,603)
48600 1605 CALL TYP(17,I)
48700 IF(RIC.EQ.-999)RIC=0
48800 WRITE(IOUT, 74)T54
48900 74 FORMAT('+ TOTAL CREDITS.',F12.2/)
49000 T18=TAX-T54
49100 CALL TYP(18,I)
49200 WRITE(IOUT, 75),T18
49300 75 FORMAT('+ ******** INCOME TAX ******',F12.2/)
49400 C******** BACK TO PAGE 2 **************************
49500 760 FORMAT('+ SELF-EMPLOYMENT TAX. (SCHED. SE) '/)
49600 IF(ACC.EQ.0.AND.T61.EQ.0)GO TO 1606
49700 WRITE(IOUT,602)
49800 CALL TYP(55,I)
49900 WRITE(IOUT,760)
50000 CALL ADUP(SETX)
50100 IF(SETX.EQ.-999)GO TO 1606
50200 IF(SETX.EQ.-99)GO TO 74
50300 761 FORMAT('+ TAX FROM RECOMPUTING INV.(FORM 4255) '/)
50400 CALL TYP(56,I)
50500 WRITE(IOUT,761)
50600 CALL ADUP(TRI)
50700 IF(TRI.EQ.-99)GO TO 760
50800 762 FORMAT('+ TAX FROM RECOMPUTING WIN. (+ SCHED.) '/)
50900 CALL TYP(57,I)
51000 WRITE(IOUT,762)
51100 CALL ADUP(TRW)
51200 IF(TRW.EQ.-99)GO TO 761
51300 763 FORMAT('+ MINIMUM TAX? (FORM 4725) '/)
51400 CALL TYP(58,I)
51500 WRITE(IOUT,763)
51600 CALL ADUP(RMT)
51700 IF(RMT.EQ.-99)GO TO 762
51800 764 FORMAT('+ SOCIAL SECURITY TAX ON TIPS. (FORM 4137) '/)
51900 CALL TYP(59,I)
52000 WRITE(IOUT,764)
52100 CALL ADUP(SST)
52200 IF(SST.EQ.-99)GO TO 763
52300 765 FORMAT('+ UNCOLLECTED SOC. SEC. TAX ON TIPS. '/)
52400 CALL TYP(60,I)
52500 WRITE(IOUT,765)
52600 CALL ADUP(TIPS)
52700 IF(TIPS.EQ.-99)GO TO 764
52800 CALL TYP(61,I)
52900 T61=TIPS+SST+RMT+TRW+TRI+SETX
53000 WRITE(IOUT,60)T61
53100
53200 C***** BACK TO PG.1 *******
53300 WRITE(IOUT,603)
53400 1606 CALL TYP(19,I)
53500 IF(SETX.EQ.-999)SETX=0
53600 WRITE(IOUT, 76)T61
53700 76 FORMAT('+ OTHER TAXES (LINE 61). ',F12.2/)
53800 T20T=TAX+T61
53900 CALL TYP(20,I)
54000 WRITE(IOUT, 60)T20T
54100 7721 CALL TYP(21,'A')
54200 77 FORMAT('+ FEDERAL TAX WITHHELD.'/)
54300 WRITE(IOUT, 77)
54400 CALL ADUP(WT)
54500 IF(WT.EQ.-99)GO TO 75
54600 CALL TYP(21,'A')
54700 WRITE(IOUT, 60)WT
54800 78 FORMAT('+ 1973 ESTIMATED TAX PAYMENTS.'/)
54900 CALL TYP(21,'B')
55000 WRITE(IOUT, 78)
55100 CALL ADUP(ET)
55200 IF(ET.EQ.-99)GO TO 77
55300 79 FORMAT('+ AMOUNT PAID WITH FORM 4868. '/)
55400 CALL TYP(21,'C')
55500 WRITE(IOUT, 79)
55600 CALL ADUP(FORM)
55700 IF(FORM.EQ.-99)GO TO 78
55800 80 CALL TYP(21,'D')
55900 WRITE(IOUT, 26)
56000
56100 IF(ACC.EQ.0.AND.T65.EQ.0)GO TO 1607
56200 WRITE(IOUT,602)
56300 800 FORMAT('+ EXCESS FICA TAX WITHHELD. (SEE PG.9) '/)
56400 CALL TYP(62,I)
56500 WRITE(IOUT,800)
56600 CALL ADUP(FIC)
56700 IF(FIC.EQ.-99)GO TO 78
56800 IF(FIC.EQ.-999)GO TO 1607
56900 801 FORMAT('+ CREDIT FOR FED. TAX ON FUELS. (FORM 4136) '/)
57000 CALL TYP(63,I)
57100 WRITE(IOUT,801)
57200 CALL ADUP(FUEL)
57300 IF(FUEL.EQ.-99)GO TO 800
57400 802 FORMAT('+ CREDIT FROM REGULATED INVSTMT. CO. (FORM 2439) '/)
57500 CALL TYP(64,I)
57600 WRITE(IOUT,802)
57700 CALL ADUP(CRICC)
57800 IF(CRICC.EQ.-99)GO TO 801
57900 T65=FIC+FUEL+CRICC
58000 CALL TYP(65,T54,I)
58100 WRITE(IOUT,60)T65
58200
58300 WRITE(IOUT,603)
58400 1607 CALL TYP(21,'D')
58500 IF(FIC.EQ.-999)FIC=0
58600 WRITE(IOUT, 26)
58700 IF(ACC.EQ.0)WRITE(IOUT,2)T65
58800 T22=WT+ET+FORM+T65
58900 CALL TYP(22,I)
59000 WRITE(IOUT, 60)T22
59100 T23=T20T-T22
59200 T23T=T23
59300 IF(T23T)T23T=0
59400 CALL TYP(23,I)
59500 82 FORMAT('+ BALANCE DUE. ------ ',F12.2/)
59600 WRITE(IOUT, 82)T23T
59700 T23=-T23
59800 IF(T23)T23=0
59900 CALL TYP(24,I)
60000 WRITE(IOUT, 83)T23
60100 83 FORMAT('+ OVERPAID ---------- ',F12.2)
60200 CALL TYP(25,I)
60300 WRITE(IOUT, 84)T23
60400 84 FORMAT('+ REFUNDED TO YOU --- ',F12.2)
60500 IF(IOUT.EQ.3)CALL EXIT
60600 IF(ACC.EQ.0)GO TO 860
60700 WRITE(IOUT, 85)
60800 85 FORMAT(//' TYPE FILE NAME. '$)
60900 ACCEPT 4,NAME
61000 CALL OFILE(1,NAME)
61100 WRITE(1)
61200 1 RIC,FTX,CCC,WIC,RIVC,TIPS,SST,RMT,
61300 1 TRW,TRI,SETX,FUEL,CRICC,FIC,ET,
61400 1 JIT,T61,T65,T54,
61500 1 EX,WG,DT,DEX,TOTD,RT,BI,CA,SU,RY,PE,CP,SI,
61600 1 ALM,OT,T38,T13,SICK,RMEX,EB,SER,T43,T15,RMI
61700 1,T1,RM,T4,T5,DO,HOSP,DOTH,T7,T8,T9,T10,TA,RX,GTAX,STAX
61800 WRITE(1)PTAX,XO,T17,RMO,ROH,T20,CO,OC,OCA,PRIOR,T24,RLOSS,RIR,
61900 1 T27,T28,T29,ALIMON,UN,SOTH,T34,T10,T17,T41,T45B,T46,T46B
62000 1,T48,T48B,TAX,T18,CRED,T20T,WT,FORM,T22,OTX
62100 1,T23T,T23,K
62200 GO TO 5
62300 201 CALL IFILE(21,NAME)
62400 READ(21)
62500 1 RIC,FTX,CCC,WIC,RIVC,TIPS,SST,RMT,
62600 1 TRW,TRI,SETX,FUEL,CRICC,FIC,ET,
62700 1 JIT,T61,T65,T54,
62800 1 EX,WG,DT,DEX,TOTD,RT,BI,CA,SU,RY,PE,CP,SI,
62900 1 ALM,OT,T38,T13,SICK,RMEX,EB,SER,T43,T15,RMI
63000 1,T1,RM,T4,T5,DO,HOSP,DOTH,T7,T8,T9,T10,TA,RX,GTAX,STAX
63100 READ(21)PTAX,XO,T17,RMO,ROH,T20,CO,OC,OCA,PRIOR,T24,RLOSS,RIR,
63200 1 T27,T28,T29,ALIMON,UN,SOTH,T34,T10,T17,T41,T45B,T46,T46B
63300 1,T48,T48B,TAX,T18,CRED,T20T,WT,FORM,T22,OTX
63400 1,T23T,T23,K
63500 860 TYPE 86
63600 86 FORMAT(' R=REWORK, T=TYPE ON TTY, L=LIST ON LPT.'/)
63700 ACCEPT 3,N
63800 IF(N.EQ.'R')GO TO 87
63900 ACC=0
64000 IF(N.EQ.'T')GO TO 4
64100 IOUT=3
64200 GO TO 4
64300 87 TYPE 88
64400 88 FORMAT(' START AT LINE 9,16,21,28,39,44,49,55,62 -- OR IN
64500 1 SCHED. A, 1,11,18,25,30?'/)
64600 ACCEPT 1,X
64700 K=X
64800 IF(K.GT.30)GO TO 89
64900 GO TO(119,1,1,1,1,1,1,1, 1100,1, 43,1,1,1,1, 7216,1, 130,
65000 1 1,1, 7721,1,1,1, 137,1,1, 17,1, 139)K
65100 89 J=K-38
65200 GO TO(27,1,1,1,1)J
65300 C ABOVE NOT FINISHED.
65400 5 END